home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Database How-To / Visual Basic 4 Database - How-to (The Waite Group)(1995).iso / owners.fr_ / owners.fr
Text File  |  1995-07-06  |  5KB  |  167 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Ownership"
  5.    ClientHeight    =   3090
  6.    ClientLeft      =   690
  7.    ClientTop       =   1875
  8.    ClientWidth     =   6750
  9.    BeginProperty Font 
  10.       name            =   "MS Sans Serif"
  11.       charset         =   0
  12.       weight          =   700
  13.       size            =   8.25
  14.       underline       =   0   'False
  15.       italic          =   0   'False
  16.       strikethrough   =   0   'False
  17.    EndProperty
  18.    Height          =   3495
  19.    Left            =   630
  20.    LinkTopic       =   "Form1"
  21.    ScaleHeight     =   3090
  22.    ScaleWidth      =   6750
  23.    Top             =   1530
  24.    Width           =   6870
  25.    Begin VB.CommandButton cmdClose 
  26.       Caption         =   "&Close"
  27.       Height          =   495
  28.       Left            =   3660
  29.       TabIndex        =   5
  30.       Top             =   2100
  31.       Width           =   1755
  32.    End
  33.    Begin VB.CommandButton cmdSave 
  34.       Caption         =   "&Save Owner"
  35.       Height          =   555
  36.       Left            =   1200
  37.       TabIndex        =   4
  38.       Top             =   2100
  39.       Width           =   1755
  40.    End
  41.    Begin VB.ListBox lstTables 
  42.       Height          =   1395
  43.       Left            =   3660
  44.       TabIndex        =   1
  45.       Top             =   360
  46.       Width           =   2535
  47.    End
  48.    Begin VB.ListBox lstUsers 
  49.       Height          =   1395
  50.       Left            =   360
  51.       Sorted          =   -1  'True
  52.       TabIndex        =   0
  53.       Top             =   360
  54.       Width           =   2535
  55.    End
  56.    Begin VB.Label Label2 
  57.       AutoSize        =   -1  'True
  58.       BackColor       =   &H00C0C0C0&
  59.       Caption         =   "Tables and queries:"
  60.       Height          =   195
  61.       Left            =   3660
  62.       TabIndex        =   3
  63.       Top             =   120
  64.       Width           =   1695
  65.    End
  66.    Begin VB.Label Label1 
  67.       AutoSize        =   -1  'True
  68.       BackColor       =   &H00C0C0C0&
  69.       Caption         =   "Users:"
  70.       Height          =   195
  71.       Left            =   360
  72.       TabIndex        =   2
  73.       Top             =   120
  74.       Width           =   555
  75.    End
  76. End
  77. Attribute VB_Name = "Form1"
  78. Attribute VB_Creatable = False
  79. Attribute VB_Exposed = False
  80. Option Explicit
  81.  
  82. #If Win32 Then
  83.     Private Declare Function GetWindowsDirectory Lib "Kernel32" _
  84.         Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, _
  85.         ByVal nSize As Long) As Long
  86. #Else
  87.     Private Declare Function GetWindowsDirectory Lib "Kernel" _
  88.         (ByVal lpBuffer As String, _
  89.         ByVal nSize As Integer) As Integer
  90. #End If
  91.  
  92. Private db As DATABASE
  93.  
  94. Private Sub Form_Load()
  95.     Dim myUser As String, myPass As String
  96.     Dim i As Integer
  97.     Dim winDir As String * 128
  98.     Dim dirLen As Integer
  99.     Dim dbName As String
  100.     
  101.     ' Get the Windows directory and set the INI path.
  102.     dirLen = GetWindowsDirectory(winDir, 128)
  103.     If dirLen = 0 Then Error 32767
  104.     DBEngine.IniPath = Left$(winDir, dirLen) & "\VBDBHT.INI"
  105.     
  106.     ' Set the user and passwords for initial login.
  107.     myUser = "Admin"
  108.     myPass = "theboss"
  109.     DBEngine.DefaultUser = myUser
  110.     DBEngine.DefaultPassword = myPass
  111.  
  112.     ' Get the database name and open the database.
  113.     dbName = DataPath() & "\CHAPTER.09\ORDERS.MDB" ' DataPath() is in READINI.BAS
  114.     Set db = DBEngine.Workspaces(0).OpenDatabase(dbName)
  115.  
  116.     ' Fill the list boxes on the form.
  117.     FillUserList
  118.     FillTableList
  119.  
  120. End Sub
  121.  
  122. Sub FillUserList()
  123.     Dim usr As User
  124.     
  125.     For Each usr In DBEngine.Workspaces(0).Users
  126.         If UCase$(usr.Name) <> "CREATOR" And UCase$(usr.Name) <> "ENGINE" Then
  127.             lstUsers.AddItem usr.Name
  128.         End If
  129.     Next
  130. End Sub
  131.  
  132. Sub FillTableList()
  133.     Dim doc As Document
  134.     
  135.     For Each doc In db.Containers("Tables").Documents
  136.         If Left$(doc.Name, 4) <> "MSys" Then lstTables.AddItem doc.Name
  137.     Next
  138.  
  139. End Sub
  140.  
  141. Private Sub lstTables_Click()
  142.     Dim i As Integer
  143.     
  144.     lstUsers.ListIndex = -1
  145.     For i = 0 To lstUsers.ListCount - 1
  146.         If lstUsers.List(i) = db.Containers("Tables").Documents(lstTables.TEXT).Owner Then
  147.             lstUsers.ListIndex = i
  148.             Exit For
  149.         End If
  150.     Next i
  151. End Sub
  152. Private Sub cmdSave_Click()
  153.     Dim doc As Document
  154.     
  155.     On Error GoTo SaveError
  156.     
  157.     db.Containers("Tables").Documents(lstTables.TEXT).Owner = lstUsers.TEXT
  158. Exit Sub
  159. SaveError:
  160.     MsgBox Err.Description & " (" & Err.Number & ")"
  161. End Sub
  162.  
  163. Private Sub cmdClose_Click()
  164.     End
  165. End Sub
  166.  
  167.